home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
ugly174.zip
/
RSB4UGLY.MRG
< prev
next >
Wrap
Text File
|
1992-07-05
|
37KB
|
901 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RELEASE\RBBSSUB4.BAS to produce RBBSSUB4.BAS
* RELEASE\RBBSSUB4.BAS: Date 6-20-1992 Size 120885 bytes
* ------------[ Created 07-04-1992 19:43:53 ]------------
* REPLACING old line(s) by new
57010 IF ZAutoDownDesired THEN _
GOTO 57020
IF NOT ZAutoDownVerified THEN _
CALL TestUser
IF NOT ZAutoDownYes THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("Sorry, AutoDownloading isn't Available.") : _ ' UG070501
ZAutoDownDesired = ZTrue
* REPLACING old line(s) by new
57040 IF ZEmphasizeOnDef$ = "" THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("Sorry, Highlighting isn't Available.") : _ ' UG070501
RETURN
IF NOT ZHiLiteOff THEN _
CALL QuickTPut (ZColorReset$,0)
CALL SetHiLite (NOT ZHiLiteOff)
GOSUB 57050
CALL UserColor
RETURN
* REPLACING old line(s) by new
57130 ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + _
* ------[ first line different ]------
" Old Bulletins at Logon" ' UG070501
GOSUB 57135 ' UG070501
CALL QuickTPut1 (ZOutTxt$)
RETURN
* INSERTING new line(s)
57135 IF MID$(ZOutTxt$,5,1) = " " THEN _ ' UG070501
ZOutTxt$ = LEFT$(ZOutTxt$,4) + MID$(ZOutTxt$,6) ' UG070501
RETURN ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
57160 ZOutTxt$ = MID$("CheckSkip ",1 -5 * ZSkipFilesLogon,5) + _
" New Files at Logon" ' UG070501
GOSUB 57135 ' UG070501
CALL QuickTPut1 (ZOutTxt$)
RETURN
* REPLACING old line(s) by new
57260 IF NOT ZUpperCase THEN _
IF (NOT ZHiLiteOff) OR ZUserGraphicDefault$ = "C" THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("Graphics & Hilite Must be Off to Use UpperCase.") : _ ' UG070501
RETURN
ZUpperCase = NOT ZUpperCase
* REPLACING old line(s) by new
58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
' $PAGE
'
' NAME -- FMS
'
' INPUTS -- PARAMETER MEANING
' DirToSearch$ RBBS-PC "DIR" CATEGORY TO LOOK
' FOR
' SearchString$ STRING TO SEARCH FOR
' SearchDate$ DATE TO SEARCH FOR
' ZCategoryName$()
' ZCategoryCode$()
' ZCategoryDesc$()
' CatFound
' ZNumCategories
'
' OUTPUTS -- ProcessedInFMS
' DnldFlag
'
' PURPOSE -- To search the file management system and display the
' files being searched for as well as the catetory descriptions
'
SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
DnldFlag = 0
CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
IF ProcessedInFMS THEN _
ZSubParm = 5 : _
GOSUB 58202 : _
* ------[ first line different ]------
ZOutTxt$ = "Scanning Directory " + _ ' UG070501
DirToSearch$ + _
SrchDir$ + _
" - " + _
ZCategoryDesc$(CatFound) : _
CALL TPut : _
Cat$ = ZCategoryCode$(CatFound) : _
CALL DispUpDir (Cat$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
EXIT SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
58304 IF ZRet THEN ' UG070509
IF ZFossil THEN ' UG070509
CALL FosTxPurge(ZComPort) ' UG070509
CALL SkipLine (1) ' UG070509
CALL QuickTPut (ZEmphasizeOff$,0) ' UG070509
END IF ' UG070509
EXIT SUB ' UG070509
END IF ' UG070509
IF ZLinesPrinted < ZFF THEN _
GOTO 58307
* REPLACING old line(s) by new
58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
' $PAGE
'
' NAME -- BufFile
'
' INPUTS -- PARAMETER MEANING
' FileSpec$ NAME OF THE FILE TO WRITE TO
' OUT TO THE USER
'
' OUTPUTS -- NONE FILE IS WRITTEN TO THE USER
'
' PURPOSE -- To display a sequential file to the user
'
SUB BufFile (FilName$,AbortIndex) STATIC
CALL FindIt (FilName$)
IF NOT ZOK THEN _
* ------[ first line different ]------
GOTO 58420 ' UG070501
ZNo = ZFalse
CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
IF ZErrCode > 0 THEN _
GOTO 58419
DataSize = ZBufferSize
FIELD 2, DataSize AS SeqRec$
ZNonStop = ZNonStop OR (ZPageLength < 1)
ZJumpLast$ = ""
ZJumpSearching = ZFalse
ZJumpSupported = ZTrue
IF NOT ZStopInterrupts THEN _
IF NOT ZConcatFIles THEN _
IF NOT ZNonStop THEN _
ZOutTxt$ = "* Ctrl-K(^K) or ^X Aborts, ^S Pauses (^Q Resumes) *" : _ ' UG070501
ZSubParm = 5 : _ ' UG070501
CALL TPut
WasTU = 0
* REPLACING old line(s) by new
* ------[ first line different ]------
58419 CALL BufString ("",-1,AbortIndex) ' UG070501
CALL SkipLine (1) ' UG070501
* INSERTING new line(s)
58420 CLOSE 2 ' UG070501
ZBypassTimeCheck = ZFalse
ZStopInterrupts = ZFalse
CALL QuickTPut (ZEmphasizeOff$,0)
ZJumpSupported = ZFalse
END SUB
* REPLACING old line(s) by new
58900 ZOutTxt$ = ZDirPrompt$
ZMacroMin = 2
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZWasQ = 0 OR ZSubParm = -1 THEN _
EXIT SUB
CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
IF ZUserIn$(ZAnsIndex) = "Q" THEN _
ZWasQ = 0 : _
EXIT SUB
ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
IF ZWasA = 0 THEN _
EXIT SUB
IF ZWasA > 8 THEN _
IF ZAnsIndex < ZLastIndex THEN _
GOTO 58900 _
ELSE GOTO 58902
IF ZWasA = 7 THEN _
ZExtendedOff = NOT ZExtendedOff _
ELSE ZExtendedOff = (ZWasA > 3)
CALL QuickTPut2 ("Extended Directory Display "+FNOffOn$(NOT ZExtendedOff)+".") ' UG070501
GOTO 58900
* REPLACING old line(s) by new
59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
' $PAGE
'
' NAME -- UserFace
'
' INPUTS -- PARAMETER MEANING
' ZCurPUI$ PUI TO USE
' ZExpertUser WHETHER CALL IN EXPERT MODE
'
' OUTPUTS -- ZWasQ
' ZUserIn$()
' ZWasZ$
'
' PURPOSE -- When sysop overrides RBBS-PC's default user
' interface (provides a MAIN.PUT), this routine
' reads in the table of specifications, presents
' the sysop menu, presents the prompt, verifies
' that a valid option has been picked, determines
' whether the option is another PUI, and passes
' back choices to be processed.
'
SUB UserFace STATIC
* ------[ first line different ]------
IF NOT ZExpertUser THEN _ ' UG070501
CALL SkipLine (1) ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
59458 IF ZExpertUser OR ZAnsIndex < ZLastIndex THEN _ ' UG070501
GOTO 59461
* REPLACING old line(s) by new
59461 MID$(ZLastCommand$,2,1) = " "
ZOutTxt$ = Prompt$
ZTurboKey = -ZTurboKeyUser
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
GOTO 59458
* REPLACING old line(s) by new
59470 MID$(ZLastCommand$,2,1) = ZWasZ$
ZOutTxt$ = QuitPrompt$
ZTurboKey = -ZTurboKeyUser
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
ZUserIn$(1) = LEFT$(QuitSubCmds$,1) : _
ZWasQ = 1
* REPLACING old line(s) by new
* ------[ first line different ]------
59492 CALL QuickTPut2 ("Sorry, No Such Command: "+ZWasZ$) : _ ' UG070501
Call FlushKeys
GOTO 59460
END SUB
* REPLACING old line(s) by new
59520 ZOutTxt$ = PassedPrompt$ 'get response
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZWasQ = 0 OR ZSubParm = -1 THEN _
EXIT SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
59547 CALL QuickTPut2 ("Sorry, Unknown Option: " + ZWasZ$) ' UG070501
ZLastIndex = 0
IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _
CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _
CurMenu$ + " but not found",1)
RETURN
* REPLACING old line(s) by new
59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
' $PAGE
'
' NAME -- MsgImport
'
' INPUTS -- PARAMETER MEANING
' MaxLines MAXIMUM # OF LINES
' MaxLen MAXIMUM LENGTH OF A LINE
' NumLines NUMBER OF LINES ALREADY IN MESSAGE
' LineAra$ ARRAY OF LINES IN MESSAGE
'
' OUTPUTS -- NumLines
' LineAra$
'
' PURPOSE -- Allows local user to append a text file to
' a message. Will word wrap if needed.
'
SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
IF NOT (ZLocalUser OR ZSysop) THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, Only for SysOps or Local Logons.") : _ ' UG070501
EXIT SUB ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
59700 ZOutTxt$ = "Import What Text File" + ZPressEnter$ ' UG070501
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
EXIT SUB
CALL FindIt (ZUserIn$(ZAnsIndex))
IF NOT ZOK THEN _
CALL QuickTPut2 (ZUserIn$(ZAnsIndex) + " Not Found.") : _ ' UG070501
GOTO 59700
WHILE NOT EOF(2) AND NumLines < MaxLines
NumLines = NumLines + 1
LINE INPUT #2,LineAra$(NumLines)
WEND
CLOSE 2
CALL WordWrap (MaxLen,NumLines,LineAra$())
END SUB
* REPLACING old line(s) by new
59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
' $PAGE
'
' NAME -- GetAll
'
' INPUTS -- PARAMETER MEANING
' LookIn$ NAME OF FILE TO SEARCH
' DIR.EXT$ MAIN DIRECTORY EXTENSION TO USE
' StartPos Last POSITION USED IN ARRAY
'
' OUTPUTS StartPos Last ELEMENT USED IN ARRAY
' LoadInto$ ARRAY TO LOAD ELEMENTS Found
'
' PURPOSE -- Creates a list (LoadInto$) of all directories
' to be listed when ZWasA)ll is selected for a directory.
' All uses config parm, which can be either a single
' directory or list of directories (begin with "@").
'
SUB GetAll (LoadInto$(1), StartPos) STATIC
IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
StartPos = StartPos + 1 : _
LoadInto$(StartPos) = ZMasterDirName$ : _
EXIT SUB
ZOK = ZFalse
IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
CALL FindIt(MID$(ZMasterDirName$,2))
IF NOT ZOK THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("No Directories Defined for A)ll. Please Tell SysOp.") : _ ' UG070501
EXIT SUB
MaxLoad = UBOUND(LoadInto$, 1)
StartSort = StartPos + 1
WHILE NOT EOF(2) AND StartPos < MaxLoad
LINE INPUT #2, ZOutTxt$
StartPos = StartPos + 1
LoadInto$(StartPos) = ZOutTxt$
WEND
CLOSE 2
END SUB
* REPLACING old line(s) by new
59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
' $PAGE
'
' NAME -- ConfMail
'
' INPUTS -- PARAMETER MEANING
' SKIP.CONFIRM Whether to skip confirm of option
' ZConfMailList$ File of user/message pairs to check
' ZActiveUserFile$ Active user file (restored on exit)
' ZActiveMessageFile$ Active msg file (restored)
' OUTPUTS -- None
'
' PURPOSE -- Quicking scans message header record to get
' last msg # and user record to get whether any
' new mail and last msg read, reports both, using
' highlighting if new mail to caller.
'
SUB ConfMail (MailCheckConfirm,LinkNew,LinkPers) STATIC
SkipJoinUnjoin = ZNonStop OR LinkNew OR LinkPers
IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
CALL FindIt (ZConfMailList$) _
ELSE ZOK = ZFalse
IF NOT ZOK THEN _
EXIT SUB
IF PrevMailList$ <> ZConfMailList$ THEN _
SkipParms = 0
PrevMailList$ = ZConfMailList$
IF MailCheckConfirm THEN _
* ------[ first line different ]------
ZOutTxt$ = "Check Conferences for Mail/Uploads ([Y],N)" : _ ' UG070501
ZTurboKey = -ZTurboKeyUser : _ ' UG070501
CALL UglyPopCmdStack : _ ' UG070501
IF ZNo OR ZSubParm < 0 THEN _
EXIT SUB
CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
' CALL SkipLine (1) ' UG070501
CALL QuickTPut1 ("Checking Message Bases (* = linked):") ' UG070501
IF LinkNew OR LinkPers THEN _
ZLinkedConf$ = ""
AnyMail = ZFalse
ZStopInterrupts = ZFalse
WasA1$ = ZActiveUserFile$
MsgFileSave$ = ZActiveMessageFile$
TempIndivValue$ = ""
UserFileIndexSave = ZUserFileIndex
UserRecordHold$ = ZUserRecord$
ZOK = ZTrue
CALL ReadParms (ZWorkAra$(),1,SkipParms)
IF SkipParms = 0 THEN _
LogicalEOF$ = "" _
ELSE LogicalEOF$ = ZWorkAra$(1)
* REPLACING old line(s) by new
59852 IF InCur THEN _
FileWait = ZFileWaiting : _
WasX = ZMailWaiting : _
ZWasA = ZLastMsgRead _
ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
ZWasB = VAL(LEFT$(ZMsgRec$,8))
WasZ = (ZWasB - ZWasA)
IF WasZ < 0 THEN _
ZWasA = 0 : _
WasZ = ZWasB _
ELSE IF WasZ = 0 THEN _
WasX = ZFalse
ZWasSL = LEN(CurPre$)
IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
Conf$ = "MAIN" _
ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
Temp = LEN(ZOutTxt$)
ZOutTxt$ = SPACE$(-(Temp<4) * (4-Temp)) + ZOutTxt$
IF (WasZ > 0 AND LinkNew) OR (WasX AND LinkPers) THEN _
IF (NOT InCur) THEN _
CALL AddLink (Conf$)
Temp = (INSTR(ZCarriageReturn$ + ZLinkedConf$,ZCarriageReturn$ + Conf$ + ZCarriageReturn$) > 0)
ZWasY$ = MID$(" *",1-Temp,1) + Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
IF WasX THEN _
* ------[ first line different ]------
WasX$ = ZEmphasizeOn$ + "Some Msgs to You" + ZEmphasizeOff$ _ ' UG070501
ELSE WasX$ = " "
IF FileWait THEN _
Temp$ = " - " + ZEmphasizeOn$ + "Some Files to You" + ZEmphasizeOff$ _ ' UG070501
ELSE Temp$ = "" ' UG070501
ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " New Messages " + _ ' UG070501
WasX$ + Temp$
ZSubParm = 5
CALL TPut
ZJumpSupported = ZFalse
IF SkipJoinUnjoin THEN _
CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
GOTO 59853
ZTurboKey = -ZTurboKeyUser
CALL AskMore (",J)oin,U)njoin,L)ink,D)elink",ZTrue,ZFalse,WasX,ZFalse)
IF ZNo THEN _
GOTO 59856
WasX$ = LEFT$(ZUserIn$(1),1)
CALL AllCaps (WasX$)
IF WasX$ = "J" THEN _
ZLastIndex = ZWasQ : _
ZHomeConf$ = Conf$ : _
GOTO 59856
IF WasX$ = "D" THEN _
CALL DeLink (Conf$) : _
GOTO 59852
IF WasX$ = "L" THEN _
CALL AddLink (Conf$) : _
GOTO 59852
IF WasX$ = "U" THEN _
IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
CALL QuickTPut1 ("Sorry, You Can't Unjoin the Current Board or Conference.") _ ' UG070501
ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
ZUserFileIndex = HoldUserFileIndex : _
ZSubParm = 6 : _
CALL FileLock : _
PUT 5, HoldUserFileIndex : _
ZSubParm = 8 : _
CALL FileLock : _
CALL QuickTPut1 ("Removed You from the " + Conf$ + " Conference.") ' UG070501
* REPLACING old line(s) by new
59856 ZActiveUserFile$ = WasA1$
CALL OpenUser (ZHighestUserRecord)
FIELD 5, 128 AS ZUserRecord$
IF (NOT ZRet) AND NOT AnyMail THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("You Haven't Joined Any Conferences.") ' UG070501
CALL SkipLine (1) ' UG070501
ZUserFileIndex = UserFileIndexSave
LSET ZUserRecord$ = UserRecordHold$
ZActiveMessageFile$ = MsgFileSave$
CALL OpenMsg
FIELD 1, 128 AS ZMsgRec$
GET 1,1
ZNonStop = (ZPageLength < 1)
WasX$ = ZUserIn$(ZAnsIndex+1)
CALL AllCaps (WasX$)
ZAnsIndex = ZAnsIndex - (WasX$ = "C")
SkipParms = -(NOT EOF(2))*SkipParms
LinkNew = ZFalse
LinkPers = ZFalse
END SUB
* REPLACING old line(s) by new
59860 CALL QuickTPut (ZEmphasizeOff$,0)
IF CantInterrupt THEN _
ZTurboKey = 2 : _
ZForceKeyboard = ZTrue : _
* ------[ first line different ]------
ZOutTxt$ = "Press a Key to Continue" _ ' UG070501
ELSE GOSUB 59870 : _
ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
WasX = LEN(ZOutTxt$) + 2
ZNoAdvance = OverWrite
ZSubParm = 1
IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
ZTurboKey = -ZTurboKeyUser
ZMacroMin = 2
CALL TGet
IF ZSubParm = -1 THEN _
EXIT SUB
ZTurboKey = ZFalse
ZWasDF$ = ZUserIn$ (1)
CALL AllCaps (ZWasDF$)
WasI = INSTR(";C;A;",";"+ZWasDF$+";")
IF WasI = 1 THEN _
ZNonStop = ZTrue : _
ZWasQ = 0
CALL WipeLine (WasX + LEN(ZUserIn$))
IF NOT ZHiLiteOff THEN _
CALL QuickTPut (ZLastSmartColor$,0)
IF CantInterrupt THEN _
ZNo = ZFalse : _
EXIT SUB
IF WasI = 3 THEN _
ZLastIndex = 0 : _
AbortIndex = 32000
IF ZNo THEN _
ZKeyboardStack$ = "" : _
ZCommPortStack$ = "" : _
ZLastSmartColor$ = ""
IF NOT ZJumpSupported THEN _
EXIT SUB
IF ZWasDF$ = "J" THEN _
IF ZWasQ > 1 THEN _
ZUserIn$ = ZUserIn$(2) : _
GOTO 59866 _
ELSE ZOutTxt$ = "Find What String" + ZPressEnterExpert$ : _ ' UG070501
CALL PopCmdStack : _
IF ZWasQ = 0 THEN _
EXIT SUB _
ELSE GOTO 59866
IF ZWasDF$ <> "R" THEN _
EXIT SUB
ZUserIn$ = ZJumpLast$
* REPLACING old line(s) by new
59970 CALL QuickTPut (ZEmphasizeOff$,0)
ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
GOSUB 59973
IF ZWasQ = 0 THEN _
ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
EXIT SUB
CALL AllCaps (ZUserIn$)
WasX = INSTR("RGYBPCW",ZUserIn$)
IF WasX = 0 THEN _
GOTO 59970
ZUserTextColor = 30 + WasX
* ------[ first line different ]------
ZOutTxt$ = "Make the Text Bright (Y,[N])" ' UG070501
GOSUB 59973
ZBoldText$ = CHR$(48 - ZYes)
ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
GOTO 59970
* REPLACING old line(s) by new
60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
' $PAGE
'
' NAME -- TimeLock (written by Doug Azzarito)
'
' INPUTS -- PARAMETER MEANING
' ZTimeLockSet SECONDS/SESSION TO LOCK
'
' OUTPUTS -- ZSubParm -1 if feature is LOCKED
'
' PURPOSE -- Check elapsed time for lock duration
'
SUB TimeLock STATIC
CALL TimeRemain(MinsRemaining)
IF ZSecsUsedSession! >= ZTimeLockSet THEN _
ZOK = ZTrue : _
EXIT SUB
* ------[ first line different ]------
' ZOutTxt$ = ZFirstName$ ' UG070501
' CALL NameCaps(ZOutTxt$) ' UG070501
CALL QuickTPut2 ("Sorry, Command is Unavailable for" + _
STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _
" Minutes," + _
STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + _ ")
" Seconds More.") ' UG070501
CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
ZOK = ZFalse
ZLastIndex = 0
END SUB
* REPLACING old line(s) by new
60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
' $PAGE
'
' NAME -- AutoPage 'Contributed by Gregg and Bob Snyder
' 'and RoseMarie Siddiqui
'
' INPUTS -- ZAutoPageDef$ List of conditions that trigger
' notification and how
'
' OUTPUTS -- NONE
'
' PURPOSE -- Search ZAutoPageDef$ for match on whether
' on name, security level, whether new user.
' Also controls whether caller notified and
' number of times sysop has bell rung.
' And what tune to play (if any).
'
SUB AutoPage STATIC
CALL FindIt (ZAutoPageDef$)
IF NOT ZOK THEN _
EXIT SUB
ZErrCode = 0
ZOK = ZFalse
WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
CALL ReadParms (ZWorkAra$(),4,1)
IF ZErrCode = 0 THEN _
ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
IF NOT ZOK THEN _
IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
ZOK = ZTrue _
ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
ZOK = ZTrue
WEND
CLOSE 2
IF ZErrCode > 0 OR NOT ZOK THEN _
ZErrCode = 0 : _
EXIT SUB
ZPageStatus$ = "AP!"
IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
* ------[ first line different ]------
ZOutTxt$ = "Wait... Telling SysOp You're Online." : _ ' UG070501
CALL RingCaller : _
CALL SkipLine (1) ' UG070501
ZWasB = (ZWorkAra$(4) = "")
ZWorkAra$(5) = ""
TempSnoop = ZSnoop
ZSnoop = ZTrue
CALL Line25
FOR WasI = 1 TO VAL(ZWorkAra$(3))
IF ZWasB THEN _
CALL LPrnt (ZBellRinger$,0) : _
ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
NEXT
IF NOT ZWasB THEN _
CALL RBBSPlay (ZWorkAra$(5))
ZSnoop = TempSnoop
END SUB
* REPLACING old line(s) by new
62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
' $PAGE
'
' NAME -- RptTime
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS --
'
' PURPOSE -- Tells user time used on system
'
SUB RptTime STATIC
* ------[ first line different ]------
' CALL SkipLine (1)
CALL GetTime
CALL AMorPM
Mins = (ZSessionHour * 60) + ZSessionMin
CALL Carrier
IF ZSubParm = -1 THEN _
EXIT SUB
CALL QuickTPut1 ("It's Now: " + DATE$ + " at " + TIME$) ' UG070501
CALL QuickTPut1 ("Time On:" + STR$(Mins) + " Minutes," + _
STR$(ZSessionSec) + " Seconds") ' UG070501
CALL Talk (7,ZOutTxt$)
END SUB
* REPLACING old line(s) by new
62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
' $PAGE
'
' NAME -- Protocol
'
' INPUTS -- PARAMETER MEANING
' ZProtoDef$ File of installed protocols
'
' OUTPUTS -- ZTransferOption$ Prompt for protocol choice
' ZDefaultXfer$ Letters of protocols
' ZInternalEquiv$ Internal protocol to use
'
' PURPOSE -- TO determine what protocols are available to user
'
SUB Protocol STATIC
CALL FindIt (ZProtoDef$)
IF NOT ZOK THEN _
* ------[ first line different ]------
ZTransferOption$ = "A)scii,X)modem,C)RCXmodem,Y)modem" : _ ' UG070501
ZInternalEquiv$ = "AXCY" : _
ZDefaultXfer$ = "AXCY" : _
GOTO 62604
ZDefaultXfer$ = ""
ZInternalEquiv$ = ""
ZTransferOption$ = ""
WasL = 0
* REPLACING old line(s) by new
62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
ZTransferOption$ = MID$(ZTransferOption$,2)
IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Protocol "+ZUserXferDefault$+" Unavailable. Default Reset to None.") : _ ' UG070501
ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
END SUB
* REPLACING old line(s) by new
62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
' $PAGE
'
' NAME -- Transfer
'
' INPUTS -- PARAMETER MEANING
' ZTransferFunction = 1 DOWNLOAD FILE TO USER
' = 2 UPLOAD FILE TO RBBS-PC
' ZFileName$ NAME OF FILE FOR Transfer
' ZComPort$ NAME OF COMMUNICATIONS PORT
' TO BE USED BY KERMIT (COM1
' OR COM2)
' ZBPS = -1 FOR 300 BAUD
' = -2 FOR 450 BAUD
' = -3 FOR 1200 BAUD
' = -4 FOR 2400 BAUD
' = -5 FOR 4800 BAUD
' = -6 FOR 9600 BAUD
' = -7 FOR 19200 BAUD
'
' OUTPUTS -- NONE
'
' PURPOSE -- To transfer files using external protocols
'
SUB Transfer STATIC
IF ZPrivateDoor THEN _
CALL PrivDoorRtn : _
EXIT SUB
IF ZTransferFunction = 1 THEN _
ZUserIn$ = ZDownTemplate$ : _
* ------[ first line different ]------
ZWasZ$ = "Send " _
ELSE IF ZTransferFunction = 2 THEN _
ZUserIn$ = ZUpTemplate$ : _
ZWasZ$ = "Receive " ' UG070501
CALL MetaGSR (ZUserIn$,ZFalse) ' UG070501
CALL QuickTPut2 ("Protocol : "+ZProtoPrompt$) ' UG070501
CALL QuickTPut ("Ready to " + ZWasZ$,0) ' UG070501
IF ZBatchTransfer THEN _
CALL QuickTPut1 ("(BATCH)") : _
CALL OpenWork (2,ZNodeWorkFile$) : _
WHILE NOT EOF(2) : _
CALL ReadAny : _
CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
CALL QuickTPut1 (" "+ZWasY$+WasX$) : _
WEND _
ELSE CALL QuickTPut1 (ZFileNameHold$)
CALL PrivDoorRtn
END SUB
* REPLACING old line(s) by new
62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
IF WasX$ = "" THEN _
EXIT SUB
CALL FindIt (WasX$)
IF NOT ZOK THEN _
ZOutTxt$ = "Missing door program" : _
CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
ZSnoop = ZTrue : _
CALL LPrnt (ZOutTxt$,1) : _
EXIT SUB
* ------[ first line different ]------
ZOutTxt$(1) = "" ' UG070507
GOSUB 62633
ZOutTxt$(2) = "ECHO" + ZOutTxt$
ZOutTxt$(3) = ZDiskForDos$ + _
"COMMAND /C " + _
ZUserIn$
ZOutTxt$(4) = ZRBBSBat$
ZPrivateDoor = ZTrue
CALL SkipLine (1) ' UG070501
CALL QuickTPut1 ("Exiting BBS to Run External Protocol...") ' UG070501
LOCATE 25,1
CALL LPrnt(ZLineFeed$,0)
CALL DoorInfo
CALL RBBSExit (ZOutTxt$(),4)
* REPLACING old line(s) by new
62629 GOSUB 62633
* ------[ first line different ]------
' CLS ' UG070507
CALL LPrnt (ZOutTxt$,2) ' UG070507
CALL ShellExit (ZUserIn$)
* REPLACING old line(s) by new
62630 IF ZPrivateDoor THEN _
CALL RestoreCom : _
CALL DelayTime (7 + ZBPS) : _
CALL SetBaud : _
* ------[ first line different ]------
CALL QuickTPut1 ("Reloading the BBS. Please Wait...") ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
62631 ' CALL SkipLine (2) ' UG070501
LOCATE 24,1
* REPLACING old line(s) by new
62670 ZOutTxt$ = Prompt$
ZMacroMin = 99
ZHidden = ZTrue
CALL PopCmdStack
ZHidden = ZFalse
IF ZSubParm < 0 OR ZWasQ = 0 THEN _
EXIT SUB
* ------[ first line different ]------
ZOutTxt$ = "" ' UG070508
IF LEN(ZUserIn$) > 15 THEN _
ZOutTxt$ = "15 Chars Max." ' UG070508
IF INSTR(ZUserIn$,";") > 0 THEN _
ZOutTxt$ = "Sorry, Password Can't Contain a Semicolon." ' UG070508
IF DisallowSpaces THEN _
IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
ZOutTxt$ = "Sorry, But All Blanks Not Allowed." ' UG070508
IF ZOutTxt$ <> "" THEN _ ' UG070508
CALL SkipLine (1) : _ ' UG070508
CALL QuickTPut2 (ZOutTxt$) : _ ' UG070508
GOTO 62670 ' UG070508
CALL AllCaps (ZUserIn$)
ZWasZ$ = ZUserIn$
END SUB
* REPLACING old line(s) by new
64005 ZChatAvail = ZFalse
QestChain = ZFalse
LastQues = 0
CALL Graphic (ZFileName$)
IF NOT ZOK THEN _
EXIT SUB
CALL ReadParms (ZOutTxt$(),2,1)
IF ZErrCode > 0 THEN _
EXIT SUB
PrevAppend$ = AppendFileName$
AppendFileName$ = ZOutTxt$(1)
MaxSecLevel = VAL(ZOutTxt$(2))
WasX = INSTR(ZOutTxt$(2)," ")
IF WasX > 0 THEN _
IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, Insufficient Security Level.") : _ ' UG070501
EXIT SUB
'
'
' * THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
' * 1. THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
' * 2. THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
' * 3. THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
' * and requires security 5 or more to access
ScriptIndex = 1
ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
" " + _
DATE$ + _
" " + _
TIME$
* REPLACING old line(s) by new
64636 IF ZAnsIndex < ZLastIndex THEN _
GOTO 64638
ZOutTxt$ = "A)utodwnld B)ullet C)ase F)ile H)ilite"
CALL TopPrompt
ZOutTxt$ = "L)ine feeds N)ulls T)urboKey X)pert !)bell"
* ------[ first line different ]------
CALL TopPrompt ' UG070501
ZOutTxt$ = "Toggle Which Options On/Off" + ZPressEnter$ ' UG070501
* REPLACING old line(s) by new
64638 ZStackC = ZTrue
ZTurboKey = -ZTurboKeyUser
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZWasQ=0 OR ZSubParm < 0 THEN _
EXIT SUB
ZWasZ$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (ZWasZ$)
ZFF = INSTR("ABCFHLNTX!",ZWasZ$)
IF ZFF < 1 THEN _
GOTO 64636
CALL Toggle (ZFF)
IF ZAnsIndex >= ZLastIndex THEN _ ' UG070501
CALL SkipLine (1) ' UG070501
GOTO 64636
END SUB
SUB TopPrompt STATIC
CALL ColorPrompt (ZOutTxt$)
CALL QuickTPut1 (ZOutTxt$)
END SUB
* REPLACING old line(s) by new
64640 ' * SysOp function 5 - change xfer stats
SUB CmndSysOpXfer STATIC
* ------[ first line different ]------
CALL QuickTPut1 (ZPressEnterNovice$) ' UG070501
ZOutTxt$ = "Upload File Total" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZUserUplds$ = MKI$(VAL(ZUserIn$(1)))
ZOutTxt$ = "Upload Byte Total" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZULBytes$ = MKS$(VAL(ZUserIn$(1)))
ZOutTxt$ = "Download File Total" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZUserDnlds$ = MKI$(VAL(ZUserIn$(1)))
ZOutTxt$ = "Download Byte Total" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZDlBytes$ = MKS$(VAL(ZUserIn$(1)))
ZOutTxt$ = "Files Downloaded Today" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZTodayDl$ = MKS$(VAL(ZUserIn$(1)))
ZOutTxt$ = "Bytes Downloaded Today" ' UG070501
GOSUB 64642
IF LEN(ZUserIn$(1)) > 0 THEN _
LSET ZTodayBytes$ = MKS$(VAL(ZUserIn$(1)))
EXIT SUB